#!/usr/bin/perl -w # For syntax highlighting
package clreqd_modules;

use strict;
use vm_info;

sub vm_migrate {
my %ARGS=@_;

	local $SIG{CHLD}='DEFAULT';
	my $type=$ARGS{TYPE};
	my $name=$ARGS{NAME};
	my $newnode=$ARGS{NEWNODE};
	my $vm_info=new vm_info($type);
	if(!defined($vm_info)) {
		return "FAIL " . vm_info::error();
	}
	my $cmd=$vm_info->get_field("migrate");
	if(!defined($cmd)) {
		return "FAIL " . vm_info::error();
	}
	if(substr($cmd,0,1) ne "/") {
		$cmd="$::ENV{TRUECL_CODE}/$cmd";
	}
	$cmd =~ s/\$\$APPNAME/$name/g;
	$cmd =~ s/\$\$NEWNODE/$newnode/g;

	# The migrate-up of the VM might be slow, might be
	# quick, so we background it and might return PID
	# if long running - like start_app. It will block the 
	# caller, but not the server.

	my $pid=fork();
	my $running=1;
	my $rc;
	if($pid) {
		if($running) {
			return "OK PID=$pid";
		}
	} else {
		open(STDOUT,">>$::ENV{TRUECL_LOG}/vm_migrate-$name.stdout");
		open(STDERR,">>$::ENV{TRUECL_LOG}/vm_migrate-$name.stderr");
		::msg("Running '$cmd [See vm_migrate-$name.stdout/stderr]'.");
		my $wfd;
		my $dir="$::ENV{TRUECL_CODE}/monitors/mailbox";
		if(!open($wfd,">$dir/.clreqd.$$") || !defined($wfd)) {
			::warning("Error attempting to write to file '$dir/.clreqd.$$' : $!");
			exit(1);
		}
		$!=undef;
		my $txt=`$cmd </dev/null 2>&1`;
		if(!defined($txt)) {
			$txt="Failed to run command '$cmd' at all!";
		}
		$rc=$?>>8;
		if($rc==0) {
			print $wfd "OK\n";
		} elsif($rc==1) {
			print $wfd "FAIL Migration not supported by virtual machine type '$type'.\n";
		} else {
			chomp $txt;
			print $wfd "FAIL $txt\n";
		}
		close($wfd);
		exit($rc);
	};
}

1;
